home *** CD-ROM | disk | FTP | other *** search
/ PC Open 107 / PC Open 107 CD 1.bin / CD1 / INTERNET / EMAIL / pop file / setup.exe / Proxy / POP3.pm < prev    next >
Encoding:
Perl POD Document  |  2004-11-29  |  28.5 KB  |  778 lines
  1. # POPFILE LOADABLE MODULE
  2. package Proxy::POP3;
  3.  
  4. use Proxy::Proxy;
  5. use Digest::MD5;
  6. @ISA = ("Proxy::Proxy");
  7.  
  8. # ----------------------------------------------------------------------------
  9. #
  10. # This module handles proxying the POP3 protocol for POPFile.
  11. #
  12. # Copyright (c) 2001-2004 John Graham-Cumming
  13. #
  14. #   This file is part of POPFile
  15. #
  16. #   POPFile is free software; you can redistribute it and/or modify
  17. #   it under the terms of the GNU General Public License as published by
  18. #   the Free Software Foundation; either version 2 of the License, or
  19. #   (at your option) any later version.
  20. #
  21. #   POPFile is distributed in the hope that it will be useful,
  22. #   but WITHOUT ANY WARRANTY; without even the implied warranty of
  23. #   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  24. #   GNU General Public License for more details.
  25. #
  26. #   You should have received a copy of the GNU General Public License
  27. #   along with POPFile; if not, write to the Free Software
  28. #   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
  29. #
  30. #   Modified by     Sam Schinke (sschinke@users.sourceforge.net)
  31. #
  32. # ----------------------------------------------------------------------------
  33.  
  34. use strict;
  35. use warnings;
  36. use locale;
  37.  
  38. # A handy variable containing the value of an EOL for networks
  39. my $eol = "\015\012";
  40.  
  41. #----------------------------------------------------------------------------
  42. # new
  43. #
  44. #   Class new() function
  45. #----------------------------------------------------------------------------
  46. sub new
  47. {
  48.     my $type = shift;
  49.     my $self = Proxy::Proxy->new();
  50.  
  51.     # Must call bless before attempting to call any methods
  52.  
  53.     bless $self, $type;
  54.  
  55.     $self->name( 'pop3' );
  56.  
  57.     $self->{child_} = \&child__;
  58.     $self->{connection_timeout_error_} = '-ERR no response from mail server';
  59.     $self->{connection_failed_error_}  = '-ERR can\'t connect to';
  60.     $self->{good_response_}            = '^\+OK';
  61.  
  62.     # Client requested APOP
  63.     $self->{use_apop__} = 0;
  64.  
  65.     # APOP username
  66.     $self->{apop_user__} = '';
  67.  
  68.     # The APOP portion of the banner sent by the POP3 server
  69.     $self->{apop_banner__} = undef;
  70.  
  71.     return $self;
  72. }
  73.  
  74. # ----------------------------------------------------------------------------
  75. #
  76. # initialize
  77. #
  78. # Called to initialize the POP3 proxy module
  79. #
  80. # ----------------------------------------------------------------------------
  81. sub initialize
  82. {
  83.     my ( $self ) = @_;
  84.  
  85.     # Enabled by default
  86.     $self->config_( 'enabled', 1);
  87.  
  88.     # By default we don't fork on Windows
  89.     $self->config_( 'force_fork', ($^O eq 'MSWin32')?0:1 );
  90.  
  91.     # Default ports for POP3 service and the user interface
  92.     $self->config_( 'port', 110 );
  93.  
  94.     # There is no default setting for the secure server
  95.     $self->config_( 'secure_server', '' );
  96.     $self->config_( 'secure_port', 110 );
  97.  
  98.     # Only accept connections from the local machine for POP3
  99.     $self->config_( 'local', 1 );
  100.  
  101.     # Whether to do classification on TOP as well
  102.     $self->config_( 'toptoo', 0 );
  103.  
  104.     # The separator within the POP3 username is :
  105.     $self->config_( 'separator', ':' );
  106.  
  107.     # The welcome string from the proxy is configurable
  108.     $self->config_( 'welcome_string',
  109.         "POP3 POPFile ($self->{version_}) server ready" );
  110.  
  111.     return $self->SUPER::initialize();
  112. }
  113.  
  114. # ----------------------------------------------------------------------------
  115. #
  116. # start
  117. #
  118. # ----------------------------------------------------------------------------
  119. sub start
  120. {
  121.     my ( $self ) = @_;
  122.  
  123.     # If we are not enabled then no further work happens in this module
  124.  
  125.     if ( $self->config_( 'enabled' ) == 0 ) {
  126.         return 2;
  127.     }
  128.  
  129.     # Tell the user interface module that we having a configuration
  130.     # item that needs a UI component
  131.  
  132.     $self->register_configuration_item_( 'configuration',              # PROFILE BLOCK START
  133.                                          'pop3_configuration',
  134.                                          'pop3-configuration-panel.thtml',
  135.                                          $self );                      # PROFILE BLOCK STOP
  136.  
  137.     $self->register_configuration_item_( 'security',                   # PROFILE BLOCK START
  138.                                          'pop3_security',
  139.                                          'pop3-security-panel.thtml',
  140.                                          $self );                      # PROFILE BLOCK STOP
  141.  
  142.     $self->register_configuration_item_( 'chain',                      # PROFILE BLOCK START
  143.                                          'pop3_chain',
  144.                                          'pop3-chain-panel.thtml',
  145.                                          $self );                      # PROFILE BLOCK STOP
  146.  
  147.     if ( $self->config_( 'welcome_string' ) =~ /^POP3 POPFile \(v\d+\.\d+\.\d+\) server ready$/ ) { # PROFILE BLOCK START
  148.         $self->config_( 'welcome_string', "POP3 POPFile ($self->{version_}) server ready" );        # PROFILE BLOCK STOP
  149.     }
  150.  
  151.     return $self->SUPER::start();
  152. }
  153.  
  154. # ----------------------------------------------------------------------------
  155. #
  156. # child__
  157. #
  158. # The worker method that is called when we get a good connection from a client
  159. #
  160. # $client         - an open stream to a POP3 client
  161. # $session        - API session key
  162. #
  163. # ----------------------------------------------------------------------------
  164. sub child__
  165. {
  166.     my ( $self, $client, $session ) = @_;
  167.  
  168.     # Hash of indexes of downloaded messages mapped to their
  169.     # slot IDs
  170.  
  171.     my %downloaded;
  172.  
  173.     # The handle to the real mail server gets stored here
  174.  
  175.     my $mail;
  176.  
  177.     $self->{apop_banner__} = undef;
  178.     $self->{use_apop__} = 0;
  179.     $self->{apop_user__} = '';
  180.  
  181.     # Tell the client that we are ready for commands and identify our
  182.     # version number
  183.  
  184.     $self->tee_( $client, "+OK " . $self->config_( 'welcome_string' ) . "$eol" );
  185.  
  186.     # Compile some configurable regexp's once
  187.  
  188.     my $s = $self->config_( 'separator' );
  189.     $s =~ s/(\$|\@|\[|\]|\(|\)|\||\?|\*|\.|\^|\+)/\\$1/;
  190.  
  191.     my $transparent  = "^USER ([^$s])+\$";
  192.     my $user_command = "USER ([^$s]+)($s(\\d+))?$s([^$s]+)($s([^$s]+))?";
  193.     my $apop_command = "APOP ([^$s]+)($s(\\d+))?$s([^$s]+) (.*?)";
  194.  
  195.     $self->log_( 2, "Regexps: $transparent, $user_command, $apop_command" );
  196.  
  197.     # Retrieve commands from the client and process them until the
  198.     # client disconnects or we get a specific QUIT command
  199.  
  200.     while  ( <$client> ) {
  201.         my $command;
  202.  
  203.         $command = $_;
  204.  
  205.         # Clean up the command so that it has a nice clean $eol at the
  206.         # end
  207.  
  208.         $command =~ s/(\015|\012)//g;
  209.  
  210.         $self->log_( 2, "Command: --$command--" );
  211.  
  212.         # The USER command is a special case because we modify the
  213.         # syntax of POP3 a little to expect that the username being
  214.         # passed is actually of the form host:username where host is
  215.         # the actual remote mail server to contact and username is the
  216.         # username to pass through to that server and represents the
  217.         # account on the remote machine that we will pull email from.
  218.         # Doing this means we can act as a proxy for multiple mail
  219.         # clients and mail accounts
  220.         #
  221.         # When the client issues the command "USER host:username:apop"
  222.         # POPFile must acknowledge the command and be prepared to
  223.         # compute the md5 digest of the user's password and the real
  224.         # pop server's banner upon receipt of a PASS command.
  225.         #
  226.         # When the client issues the command "USER host:username:ssl"
  227.         # POPFile will use SSL for the connection to the remote, note
  228.         # that the user can say host:username:ssl,apop if both are
  229.         # needed
  230.  
  231.         if ( $command =~ /$transparent/ ) {
  232.             if ( $self->config_( 'secure_server' ) ne '' )  {
  233.                 if ( $mail = $self->verify_connected_( $mail, $client,  $self->config_( 'secure_server' ), $self->config_( 'secure_port' ) ) )  {
  234.                     last if ($self->echo_response_($mail, $client, $command) == 2 );
  235.                 } else {
  236.                     next;
  237.                 }
  238.             } else {
  239.                 $self->tee_(  $client, "-ERR Transparent proxying not configured: set secure server/port$eol" );
  240.             }
  241.  
  242.             next;
  243.         }
  244.  
  245.         if ( $command =~ /$user_command/i ) {
  246.             if ( $1 ne '' )  {
  247.                 my ( $host, $port, $user, $options ) = ($1, $3, $4, $6);
  248.  
  249.                 $self->mq_post_( 'LOGIN', $user );
  250.  
  251.                 my $ssl = defined( $options ) && ( $options =~ /ssl/i );
  252.                 $port = 110 if ( !defined( $port ) );
  253.  
  254.                 if ( $mail = $self->verify_connected_( $mail, $client,
  255.                                  $host, $port, $ssl ) )  {
  256.  
  257.                     if ( defined( $options ) && ( $options =~ /apop/i ) ) {
  258.  
  259.                         # We want to make sure the server sent a real
  260.                         # APOP banner, containing <>'s
  261.  
  262.                         $self->{apop_banner__} = $1 if $self->{connect_banner__} =~ /(<[^>]+>)/;
  263.                         $self->log_( 2, "banner=" . $self->{apop_banner__} ) if defined( $self->{apop_banner__} );
  264.  
  265.                         # any apop banner is ok
  266.  
  267.                         if ( defined($self->{apop_banner__})) {
  268.                             $self->{use_apop__} = 1; #
  269.                             $self->log_( 2, "auth APOP" );
  270.                             $self->{apop_user__} = $user;
  271.  
  272.                             # tell the client that username was
  273.                             # accepted don't flush_extra, we didn't
  274.                             # send anything to the real server
  275.  
  276.                             $self->tee_( $client, "+OK hello $user$eol" );
  277.                             next;
  278.                         } else {
  279.  
  280.                             # If the client asked for APOP, and the
  281.                             # server doesn't have the correct banner,
  282.                             # give a meaningful error instead of
  283.                             # whatever error the server might have if
  284.                             # we try to make up a hash
  285.  
  286.                             $self->{use_apop__} = 0;
  287.                             $self->tee_( $client, "-ERR $host doesn't support APOP, aborting authentication$eol" );
  288.                             next;
  289.                         }
  290.                     } else {
  291.  
  292.                         # Pass through the USER command with the
  293.                         # actual user name for this server, and send
  294.                         # the reply straight to the client
  295.  
  296.                         $self->log_( 2, "auth plaintext" );
  297.                         $self->{use_apop__} = 0;         # signifies a non-apop connection
  298.                         last if ($self->echo_response_( $mail, $client, 'USER ' . $user ) == 2 );
  299.                     }
  300.  
  301.                 } else {
  302.  
  303.                     # If the login fails then we want to continue in
  304.                     # the unlogged in state so that clients can send
  305.                     # us the QUIT command
  306.  
  307.                     next;
  308.                 }
  309.             }
  310.  
  311.             next;
  312.         }
  313.  
  314.         # User is issuing the APOP command to start a session with the
  315.         # remote server
  316.  
  317.         if ( ( $command =~ /PASS (.*)/i ) ) {
  318.             if ( $self->{use_apop__} ) {
  319.  
  320.                 # Authenticate with APOP
  321.  
  322.                 my $md5 = Digest::MD5->new;
  323.  
  324.                 $md5->add( $self->{apop_banner__}, $1 );
  325.                 my $md5hex = $md5->hexdigest;
  326.                 $self->log_( 2, "digest='$md5hex'" );
  327.  
  328.                 my ($response, $ok) =
  329.                     $self->get_response_( $mail, $client,
  330.                         "APOP $self->{apop_user__} $md5hex", 0, 1 );
  331.                 if ( ( $ok == 1 ) &&
  332.                      ( $response =~ /$self->{good_response_}/ ) ) {
  333.  
  334.                     # authentication OK, toss the hello response and
  335.                     # return password ok
  336.  
  337.                     $self->tee_( $client, "+OK password ok$eol" );
  338.                 } else {
  339.                     $self->tee_( $client, "$response" );
  340.                 }
  341.              } else {
  342.                last if ($self->echo_response_($mail, $client, $command) == 2 );
  343.              }
  344.              next;
  345.         }
  346.  
  347.         # User is issuing the APOP command to start a session with the
  348.         # remote server We'd need a copy of the plaintext password to
  349.         # support this.
  350.  
  351.         if ( $command =~ /$apop_command/io ) {
  352.             $self->tee_( $client,
  353.               "-ERR APOP not supported between mail client and POPFile.$eol" );
  354.  
  355.             # TODO: Consider implementing a host:port:username:secret
  356.             # hash syntax for proxying the APOP command
  357.  
  358.             next;
  359.         }
  360.  
  361.         # Secure authentication
  362.  
  363.         if ( $command =~ /AUTH ([^ ]+)/ ) {
  364.             if ( $self->config_( 'secure_server' ) ne '' )  {
  365.                 if ( $mail = $self->verify_connected_( $mail, $client,  $self->config_( 'secure_server' ), $self->config_( 'secure_port' ) ) )  {
  366.  
  367.                     # Loop until we get -ERR or +OK
  368.  
  369.                     my ( $response, $ok ) = $self->get_response_( $mail, $client, $command );
  370.  
  371.                     while ( ( ! ( $response =~ /\+OK/ ) ) && ( ! ( $response =~ /-ERR/ ) ) ) {
  372.                         my $auth;
  373.                         $auth = <$client>;
  374.                         $auth =~ s/(\015|\012)$//g;
  375.                         ( $response, $ok ) = $self->get_response_( $mail, $client, $auth );
  376.                     }
  377.                 } else {
  378.                     next;
  379.                 }
  380.             } else {
  381.                 $self->tee_(  $client, "-ERR No secure server specified$eol" );
  382.             }
  383.  
  384.             next;
  385.         }
  386.  
  387.         if ( $command =~ /AUTH/ ) {
  388.             if ( $self->config_( 'secure_server' ) ne '' )  {
  389.                 if ( $mail = $self->verify_connected_( $mail, $client,  $self->config_( 'secure_server' ), $self->config_( 'secure_port' ) ) )  {
  390.                     my $response = $self->echo_response_($mail, $client, "AUTH" );
  391.                     last if ( $response == 2 );
  392.                     if ( $response == 0 ) {
  393.                         $self->echo_to_dot_( $mail, $client );
  394.                     }
  395.                 } else {
  396.                     next;
  397.                 }
  398.             } else {
  399.                 $self->tee_(  $client, "-ERR No secure server specified$eol" );
  400.             }
  401.  
  402.             next;
  403.         }
  404.  
  405.         # The client is requesting a LIST/UIDL of the messages
  406.  
  407.         if ( ( $command =~ /LIST ?(.*)?/i ) ||       # PROFILE BLOCK START
  408.              ( $command =~ /UIDL ?(.*)?/i ) ) {      # PROFILE BLOCK STOP
  409.             my $response = $self->echo_response_($mail, $client, $command );
  410.             last if ( $response == 2 );
  411.             if ( $response == 0 ) {
  412.                 $self->echo_to_dot_( $mail, $client ) if ( $1 eq '' );
  413.             }
  414.  
  415.             next;
  416.         }
  417.  
  418.         # TOP handling is rather special because we have three cases
  419.         # that we handle
  420.         #
  421.         # 1. If the client sends TOP x 99999999 then it is most likely
  422.         #    to be fetchmail and the intent of fetchmail is to
  423.         #    actually get the message but for its own reasons it does
  424.         #    not use RETR.  We use RETR as the clue to place a message
  425.         #    in the history, so we have a hack.  If the client looks
  426.         #    like fetchmail then TOP x 99999999 is actually
  427.         #    implemented using RETR
  428.         #
  429.         # 2. The toptoo configuration controls whether email
  430.         #    downloaded using the TOP command is classified or not (It
  431.         #    may be downloaded and cached for bandwidth efficiency, and
  432.         #    thus appear in the history).  There are two cases:
  433.         #
  434.         # 2a If toptoo is 0 then POPFile will pass a TOP from the
  435.         #    client through as a TOP and do no classification on the
  436.         #    message.
  437.         #
  438.         # 2b If toptoo is 1 then POPFile first does a RETR on the
  439.         #    message and saves it in the history so that it can get the
  440.         #    classification on the message which is stores in $class.
  441.         #    Then it gets the message again by sending the TOP command
  442.         #    and passing the result through classify_and_modify passing
  443.         #    in the $class determined above.  This means that the message
  444.         #    gets the right classification and the client only gets the
  445.         #    headers requested plus so many lines of body, but they will
  446.         #    get subject modification, and the XTC and XPL headers add.
  447.         #    Note that TOP always returns the full headers and then n
  448.         #    lines of the body so we are guaranteed to be able to do our
  449.         #    header modifications.
  450.         #
  451.         # NOTE messages retrieved using TOPTOO are visible in the
  452.         #      history as they are "cached" to avoid requiring repeated
  453.         #      downloads if the client issues a RETR for the message in
  454.         #      the same session
  455.         #
  456.         # NOTE using toptoo=1 on a slow link could cause
  457.         #      performance problems, in cases where only the headers,
  458.         #      but not classification, is required.  toptoo=1 is,
  459.         #      however, appropriate for normal use via a mail client and
  460.         #      won't significantly increase bandwidth unless the mail
  461.         #      client is selectively downloading messages based on
  462.         #      non-classification data in the TOP headers.
  463.  
  464.         if ( $command =~ /TOP (.*) (.*)/i ) {
  465.             my $count = $1;
  466.  
  467.             if ( $2 ne '99999999' )  {
  468.                 if ( $self->config_( 'toptoo' ) == 1 ) {
  469.                     my $response =
  470.                         $self->echo_response_( $mail, $client, "RETR $count" );
  471.                     last if ( $response == 2 );
  472.                     if ( $response == 0 ) {
  473.  
  474.                         # Classify without echoing to client, saving
  475.                         # file for later RETR's
  476.  
  477.                         my ( $class, $slot ) =
  478.                              $self->{classifier__}->classify_and_modify(
  479.                                  $session, $mail, $client, 0, '', 0, 0 );
  480.  
  481.                         $downloaded{$count} = $slot;
  482.  
  483.                         # Note that the 1 here indicates that
  484.                         # echo_response_ does not send the response to
  485.                         # the client.  The +OK has already been sent
  486.                         # by the RETR
  487.  
  488.                         $response =
  489.                             $self->echo_response_( $mail, $client,
  490.                                 $command, 1 );
  491.                         last if ( $response == 2 );
  492.                         if ( $response == 0 ) {
  493.  
  494.                             # Classify with pre-defined class, without
  495.                             # saving, echoing to client
  496.  
  497.                             $self->{classifier__}->classify_and_modify(
  498.                                 $session, $mail, $client, 1, $class, $slot, 1 );
  499.                         }
  500.                     }
  501.                 } else {
  502.                     my $response =
  503.                         $self->echo_response_( $mail, $client, $command );
  504.                     last if ( $response == 2 );
  505.                     if ( $response == 0 ) {
  506.                         $self->echo_to_dot_( $mail, $client );
  507.             }
  508.                 }
  509.  
  510.                 next;
  511.             }
  512.  
  513.             # Note the fall through here.  Later down the page we look
  514.             # for TOP x 99999999 and do a RETR instead
  515.         }
  516.  
  517.         # The CAPA command
  518.  
  519.         if ( $command =~ /CAPA/i ) {
  520.             if ( $mail || $self->config_( 'secure_server' ) ne '' )  {
  521.                 if ( $mail || ( $mail = $self->verify_connected_( $mail, $client, $self->config_( 'secure_server' ), $self->config_( 'secure_port' ) ) ) )  {
  522.                     my $response = $self->echo_response_($mail, $client, "CAPA" );
  523.                     last if ( $response == 2 );
  524.                     if ( $response == 0 ) {
  525.                         $self->echo_to_dot_( $mail, $client );
  526.             }
  527.                 } else {
  528.                     next;
  529.                 }
  530.             } else {
  531.                 $self->tee_(  $client, "-ERR No secure server specified$eol" );
  532.             }
  533.  
  534.             next;
  535.         }
  536.  
  537.         # The HELO command results in a very simple response from us.
  538.         # We just echo that we are ready for commands
  539.  
  540.         if ( $command =~ /HELO/i ) {
  541.             $self->tee_(  $client, "+OK HELO POPFile Server Ready$eol" );
  542.             next;
  543.         }
  544.  
  545.         # In the case of PASS, NOOP, XSENDER, STAT, DELE and RSET
  546.         # commands we simply pass it through to the real mail server
  547.         # for processing and echo the response back to the client
  548.  
  549.         if ( ( $command =~ /NOOP/i )         ||                 # PROFILE BLOCK START
  550.              ( $command =~ /STAT/i )         ||
  551.              ( $command =~ /XSENDER (.*)/i ) ||
  552.              ( $command =~ /DELE (.*)/i )    ||
  553.              ( $command =~ /RSET/i ) ) {                        # PROFILE BLOCK STOP
  554.             last if ( $self->echo_response_($mail, $client, $command ) == 2 );
  555.             next;
  556.         }
  557.  
  558.         # The client is requesting a specific message.  Note the
  559.         # horrible hack here where we detect a command of the form TOP
  560.         # x 99999999 this is done so that fetchmail can be used with
  561.         # POPFile.
  562.  
  563.         if ( ( $command =~ /RETR (.*)/i ) || ( $command =~ /TOP (.*) 99999999/i ) )  {
  564.             my $count = $1;
  565.             my $class;
  566.             my $file;
  567.  
  568.             if ( defined($downloaded{$count}) &&
  569.                  ( $file = $self->{history__}->get_slot_file( $downloaded{$count} ) ) &&
  570.                  (open RETRFILE, "<$file") ) {
  571.  
  572.                 # act like a network stream
  573.  
  574.                 binmode RETRFILE;
  575.  
  576.                 # File has been fetched and classified already
  577.  
  578.                 $self->log_( 1, "Printing message from cache" );
  579.  
  580.                 # Give the client an +OK:
  581.  
  582.                 $self->tee_( $client, "+OK " . ( -s $file ) . " bytes from POPFile cache$eol" );
  583.  
  584.                 # Load the last classification
  585.  
  586.                 my ( $id, $from, $to, $cc, $subject,
  587.                     $date, $hash, $inserted, $bucket, $reclassified ) =
  588.                     $self->{history__}->get_slot_fields( $downloaded{$count} );
  589.  
  590.                 if ( $bucket ne 'unknown class' ) {
  591.  
  592.                     # echo file, inserting known classification,
  593.                     # without saving
  594.  
  595.                     ($class, undef) = $self->{classifier__}->classify_and_modify( $session, \*RETRFILE, $client, 1, $bucket, $downloaded{$count} );
  596.                     print $client ".$eol";
  597.  
  598.                 } else {
  599.  
  600.                     # If the class wasn't saved properly, classify
  601.                     # from disk normally
  602.  
  603.                     ($class, undef) = $self->{classifier__}->classify_and_modify( $session, \*RETRFILE, $client, 1, '', 0 );
  604.                     print $client ".$eol";
  605.                 }
  606.  
  607.                 close RETRFILE;
  608.             } else {
  609.  
  610.                 # Retrieve file directly from the server
  611.  
  612.                 # Get the message from the remote server, if there's
  613.                 # an error then we're done, but if not then we echo
  614.                 # each line of the message until we hit the . at the
  615.                 # end
  616.  
  617.                 my $response = $self->echo_response_($mail, $client, $command );
  618.  
  619.                 last if ( $response == 2 );
  620.                 if ( $response == 0 ) {
  621.                     my $slot;
  622.                     ( $class, $slot ) = $self->{classifier__}->classify_and_modify( $session, $mail, $client, 0, '', 0 );
  623.  
  624.                     # Note locally that file has been retrieved if the
  625.                     # full thing has been saved to disk
  626.  
  627.                     $downloaded{$count} = $slot;
  628.                 }
  629.             }
  630.  
  631.             next;
  632.         }
  633.  
  634.         # The mail client wants to stop using the server, so send that
  635.         # message through to the real mail server, echo the response
  636.         # back up to the client and exit the while.  We will close the
  637.         # connection immediately
  638.  
  639.         if ( $command =~ /QUIT/i ) {
  640.             if ( $mail )  {
  641.                 last if ( $self->echo_response_( $mail, $client, $command ) == 2 );
  642.                 close $mail;
  643.             } else {
  644.                 $self->tee_( $client, "+OK goodbye$eol" );
  645.             }
  646.             last;
  647.         }
  648.  
  649.         # Don't know what this is so let's just pass it through and
  650.         # hope for the best
  651.  
  652.         if ( $mail && $mail->connected )  {
  653.             last if ( $self->echo_response_($mail, $client, $command ) == 2 );
  654.             next;
  655.         } else {
  656.             $self->tee_(  $client, "-ERR unknown command or bad syntax$eol" );
  657.             next;
  658.         }
  659.  
  660.     }
  661.  
  662.     if ( defined( $mail ) ) {
  663.         $self->done_slurp_( $mail );
  664.         close $mail;
  665.     }
  666.  
  667.     close $client;
  668.     $self->mq_post_( 'CMPLT', $$ );
  669.     $self->log_( 0, "POP3 proxy done" );
  670. }
  671.  
  672. # ----------------------------------------------------------------------------
  673. #
  674. # configure_item
  675. #
  676. #    $name            Name of this item
  677. #    $templ           The loaded template that was passed as a parameter
  678. #                     when registering
  679. #    $language        Current language
  680. #
  681. # ----------------------------------------------------------------------------
  682.  
  683. sub configure_item
  684. {
  685.     my ( $self, $name, $templ, $language ) = @_;
  686.  
  687.     if ( $name eq 'pop3_configuration' ) {
  688.         $templ->param( 'POP3_Configuration_If_Force_Fork' => ( $self->config_( 'force_fork' ) == 0 ) );
  689.         $templ->param( 'POP3_Configuration_Port'          => $self->config_( 'port' ) );
  690.         $templ->param( 'POP3_Configuration_Separator'     => $self->config_( 'separator' ) );
  691.     } else {
  692.         if ( $name eq 'pop3_security' ) {
  693.             $templ->param( 'POP3_Security_Local' => ( $self->config_( 'local' ) == 1 ) );
  694.     } else {
  695.             if ( $name eq 'pop3_chain' ) {
  696.                 $templ->param( 'POP3_Chain_Secure_Server' => $self->config_( 'secure_server' ) );
  697.                 $templ->param( 'POP3_Chain_Secure_Port' => $self->config_( 'secure_port' ) );
  698.         } else {
  699.                 $self->SUPER::configure_item( $name, $templ, $language );
  700.         }
  701.         }
  702.     }
  703. }
  704.  
  705. # ----------------------------------------------------------------------------
  706. #
  707. # validate_item
  708. #
  709. #    $name            The name of the item being configured, was passed in by the call
  710. #                     to register_configuration_item
  711. #    $templ           The loaded template
  712. #    $language        The language currently in use
  713. #    $form            Hash containing all form items
  714. #
  715. # ----------------------------------------------------------------------------
  716.  
  717. sub validate_item
  718. {
  719.     my ( $self, $name, $templ, $language, $form ) = @_;
  720.  
  721.     if ( $name eq 'pop3_configuration' ) {
  722.         if ( defined($$form{pop3_port}) ) {
  723.             if ( ( $$form{pop3_port} >= 1 ) && ( $$form{pop3_port} < 65536 ) ) {
  724.                 $self->config_( 'port', $$form{pop3_port} );
  725.                 $templ->param( 'POP3_Configuration_If_Port_Updated' => 1 );
  726.                 $templ->param( 'POP3_Configuration_Port_Updated' => sprintf( $$language{Configuration_POP3Update}, $self->config_( 'port' ) ) );
  727.             } else {
  728.                 $templ->param( 'POP3_Configuration_If_Port_Error' => 1 );
  729.             }
  730.         }
  731.  
  732.         if ( defined($$form{pop3_separator}) ) {
  733.             if ( length($$form{pop3_separator}) == 1 ) {
  734.                 $self->config_( 'separator', $$form{pop3_separator} );
  735.                 $templ->param( 'POP3_Configuration_If_Sep_Updated' => 1 );
  736.                 $templ->param( 'POP3_Configuration_Sep_Updated' => sprintf( $$language{Configuration_POP3SepUpdate}, $self->config_( 'separator' ) ) );
  737.             } else {
  738.                 $templ->param( 'POP3_Configuration_If_Sep_Error' => 1 );
  739.             }
  740.         }
  741.  
  742.         if ( defined($$form{pop3_force_fork}) ) {
  743.             $self->config_( 'force_fork', $$form{pop3_force_fork} );
  744.         }
  745.  
  746.         return;
  747.     }
  748.  
  749.     if ( $name eq 'pop3_security' ) {
  750.         $self->config_( 'local', $$form{pop3_local}-1 ) if ( defined($$form{pop3_local}) );
  751.  
  752.         return;
  753.     }
  754.  
  755.     if ( $name eq 'pop3_chain' ) {
  756.         if ( defined( $$form{server} ) ) {
  757.             $self->config_( 'secure_server', $$form{server} );
  758.             $templ->param( 'POP3_Chain_If_Server_Updated' => 1 );
  759.             $templ->param( 'POP3_Chain_Server_Updated' => sprintf( $$language{Security_SecureServerUpdate}, $self->config_( 'secure_server' ) ) );
  760.     }
  761.  
  762.         if ( defined($$form{sport}) ) {
  763.             if ( ( $$form{sport} >= 1 ) && ( $$form{sport} < 65536 ) ) {
  764.                 $self->config_( 'secure_port', $$form{sport} );
  765.                 $templ->param( 'POP3_Chain_If_Port_Updated' => 1 );
  766.                 $templ->param( 'POP3_Chain_Port_Updated' => sprintf( $$language{Security_SecurePortUpdate}, $self->config_( 'secure_port' ) ) );
  767.             } else {
  768.                 $templ->param( 'POP3_Chain_If_Port_Error' => 1 );
  769.             }
  770.         }
  771.  
  772.         return;
  773.     }
  774.  
  775.     $self->SUPER::validate_item( $name, $templ, $language, $form );
  776. }
  777.  
  778.